! Takes Fortran 77 code in standard format and makes some changes to produce
! free-format Fortran 90 code.
! N.B. It expects STANDARD F77 code.   Non-standard extensions such as
! DO .. END DO (i.e. no label) or in-line comments may cause havoc!
! Changes included are:
!     C or c in column 1 replaced with !
!     Continuation denoted by a character in column 6 replaced with & at the
!         end of the previous line.
!     Indenting of code for DO-loops and IF blocks.
!     END of program unit replaced by END SUBROUTINE (/PROGRAM/FUNCTION) name
!     Fortran `keywords' are in upper case, all other words other than those
!         in character strings are converted to lower case.
!     .LT., .EQ., etc. replaced with <, ==, etc.
!     Labels removed from DO loops; all of which will end with END DO.
!         If labels are not referenced, they are removed.
!     Short continued lines are adjoined to the previous line.
!     ENDIF, ELSEIF & GOTO split into separate words.
!     3-way arithmetic IF constructs are converted to IF .. ELSE IF form.
!     Embedded blanks are removed from numbers in DATA statements.
!     INTENT declarations are added for dummy arguments.
!     Some GO TOs are converted to CYCLE or EXIT.
!     Converts CHARACTER * to CHARACTER (LEN=xx) ::.
!     Converts computed GO TOs to SELECT CASE.
! To be done:
!     DATA statements to be replaced by assignments on the declaration line.
!     IMPLICIT NONE statements to be included.
!     Declaration of types of unlisted variables.
!     Functions to be converted to ELF90 form, i.e. REAL FUNCTION XYZ(arg)
!         converted to FUNCTION xyz(arg) RESULT(fn_val).
! Known problems
!     Cannot handle character strings or names broken at the end of lines.
!     No attempt to convert BLOCKDATA, COMMON or EQUIVALENCE.
!     Does not convert Hollerith strings, e.g. 31HTHIS IS A COMMENT ...
!     May do the wrong thing if variable names start with IF or end with DO.
!     INTENTs are sometimes wrong.  In particular, INTENT(IN) arguments are
!         often shown as INTENT(IN OUT).
!     Cannot handle comment lines in the middle of continued instructions.
!     Can handle 'character*(*) str' but not 'character str*(*)'.
! The default extension for the name of the input file is `for'; this can be
! over-ruled by giving the full name (e.g. myprog.f77).   The output file name
! will be the input name (and directory) with extension `.f90'.
! Added conversion of `enddo' to END DO - 13 March 1997
! Corrected bug which occurred when an arithmetic IF within a DO-loop involved
!     a jump to the end of the DO-loop - 17 August 1997.
! ELSEIF, ENDIF & ELSEIF were being split into 2 separate words, and then the
!     last letter converted back to lower case - corrected 17 August 1997.
! Corrected bug which occurred when .LT. (or other comparison) had a blank
!     before and/or after, followed on the same line by a text string, followed
!     by a Fortran word such as THEN or GO TO - 8 December 1997.
! Added (LEN=1) after CHARACTER if length not specified - 9 December 1997.
! Embedded blanks are removed from numerical constants in DATA statements.
!     Added 9 December 1997.
! Added INTENTs and TYPE declarations for dummy arguments - 23 December 1997.
! Corrected problem when DO statement contains a comma immediately after DO,
!     and improved the detection of INTENTs when a dummy argument appears in an
!     IF-expression.  Added extra indentation on continuation lines to improve
!     readability - 13 January 1998
! Corrected a bug which could occur when the last type declaration was matched
!     to a dummy variable and the line deleted - 5 June 1998
! Corrected jumps out of inner nested DO loops, and replaced GO TOs, out of
!     DO loops to the next executable line, with EXIT - 8 June 1998
! Added conversion of CHARACTER * to CHARACTER (LEN=xx) ::
!     including CHARACTER*10 a, d, c*50, d   - 21 June 1998.
! Corrected for case of final command of a DO loop which is not CONTINUE and
!     which flows onto the next line - 29 June 1998.
! Added conversionof computed GO TOs to SELECT CASE form, and
!     fixed problem when a CHARACTER dummy variable had '*' as its last
!     dimension - 26 November 1998.
! Fixed problems when the dimensions of a dummy variable involved another
!     dummy variable, e.g. wk(nrow*(ncols+1)) - 25 December 1998
! Added date & time stamp - 27 January 1999
! Finally fixed the problems with CYCLE & EXIT, I hope! - 2 February 1999
! Fixed a problem when a type declaration was continued and the next line
!     declared the type(s) of dummy arguments - 3 February 1999
! Added conversion of PARAMETER statements from PARAMETER (name1=v1, .. )
!     to TYPE1, PARAMETER :: name1=v1  - 8 February 1999
! Added EQV to the list of FORTRAN `words' - 11 February 1999
! Partially corrected problems with the construct:
!     IF (condition) GO TO (10, 20, ..
!       ..., 99), next
!     i.e. with IF & computed GOTO in the same statement (without a THEN), and
!     continued onto the next line.
!     Also changed a DATA statement to a PARAMETER statement to make the code
!     compatible with ELF90 (Thanks to David Ormerod) - 20 May 1999
! Added test for existence of source file.  Program crashed previously if
!     the file was not found - 3 August 1999
! Corrected SUBROUTINE fix_3way_IF so that it does not interpret IFIX (or
!     similar) as an IF - 23 January 2000.
! At last fixed up strings in quotes which flowed from one line to the next
!     - 24 January 2000
! Fixed an error which sometimes caused GOTOs to be wrongly converted to CYCLE
!     - 21 March 2000
! Latest revision - 21 March 2000
! Author - Alan Miller  (amiller @ bigpond.net.au)
! WWW-page: http://users.bigpond.net.au/amiller/
MODULE implicit
    ! Module to set and reset implicit variable types for use by to_f90.
    IMPLICIT NONE
    INTEGER, SAVE :: var_type(26) = (/  &
        1,1,1,1,1,1,1,1,2,2,2,2,2,2,1,1,1,1,1,1,1,1,1,1,1,1 /)
    !   a b c d e f g h i j k l m n o p q r s t u v w x y z
    CHARACTER (LEN=24), SAVE :: vt(0:7) = (/ 'NO TYPE                 ', &
        'REAL                    ', &
        'INTEGER                 ', &
        'DOUBLE PRECISION        ', &
        'LOGICAL                 ', &
        'COMPLEX                 ', &
        'CHARACTER               ', &
        'OTHER TYPE              ' /)
CONTAINS
    SUBROUTINE reset_defaults()
        var_type(1:8) = 1            ! REAL (A-H)
        var_type(9:14) = 2           ! INTEGER (I-N)
        var_type(15:26) = 1          ! REAL (O-Z)
        RETURN
    END SUBROUTINE reset_defaults
    SUBROUTINE set_implicit_types(text)
        ! Read in implicit statement and interpret.
        CHARACTER (LEN=*), INTENT(IN OUT) :: text
        ! Local variables
        INTEGER :: ivt, length, start, i, j, pos, left, right
        LOGICAL :: first
        i = INDEX(text, 'IMPLICIT')
        IF (i > 0) text = text(i+8:)
        text = ADJUSTL(text)
        DO
            IF (text(1:4) == 'NONE') THEN
                var_type = 0
                RETURN
            ELSE IF (text(1:4) == 'REAL') THEN
                ivt = 1
            ELSE IF (text(1:7) == 'INTEGER') THEN
                ivt = 2
            !ELSE IF (text(1:24) == 'DOUBLE PRECISION COMPLEX') THEN
            ELSE IF (text(1:14) == 'DOUBLE COMPLEX') THEN
                ivt = 7
                !vt(7) = 'DOUBLE PRECISION COMPLEX'
                vt(7) = 'DOUBLE COMPLEX'
            ELSE IF (text(1:16) == 'DOUBLE PRECISION') THEN
                ivt = 3
            ELSE IF (text(1:7) == 'LOGICAL') THEN
                ivt = 4
            ELSE IF (text(1:7) == 'COMPLEX') THEN
                ivt = 5
            ELSE IF (text(1:9) == 'CHARACTER') THEN
                ivt = 6
            ELSE
                ivt = 7
                i = INDEX(text, ' ')
                vt(7) = text(1:i-1)
            END IF
            ! Interpret the part in brackets, e.g. (a - h, o - z)
            length = LEN_TRIM(text)
            start = 5
            left = INDEX(text(start:length), '(') + start - 1
            IF (left < start) RETURN
            right = INDEX(text(start:length), ')') + start - 1
            IF (right < left) RETURN
            ! Interpret text(left+1:right-1)
            first = .TRUE.
            DO pos = left+1, right
                SELECT CASE (text(pos:pos))
                CASE (' ')
                    CYCLE
                CASE ('-')
                    first = .FALSE.
                CASE (',', ')')
                    IF (first) THEN
                        var_type(i) = ivt
                    ELSE
                        var_type(i:j) = ivt
                        first = .TRUE.
                    END IF
                CASE DEFAULT
                    IF (first) THEN
                        i = ICHAR(text(pos:pos)) - ICHAR('a') + 1
                        IF (i < 1) THEN
                            i = ICHAR(text(pos:pos)) - ICHAR('A') + 1
                        END IF
                    ELSE
                        j = ICHAR(text(pos:pos)) - ICHAR('a') + 1
                        IF (j < 1) THEN
                            j = ICHAR(text(pos:pos)) - ICHAR('A') + 1
                        END IF
                    END IF
                END SELECT
            END DO
            start = right + 1
            IF (start >= length) RETURN
            text = text(start:length)
            DO
                IF (text(1:1) == ',' .OR. text(1:1) == ' ') THEN
                    text = text(2:)
                ELSE
                    EXIT
                END IF
            END DO
        END DO
        RETURN
    END SUBROUTINE set_implicit_types
    FUNCTION implicit_type(ch) RESULT(vtype)
        ! Return the variable type given the first character of its name.
        ! The first character is expected to be lower case, but just in case ..
        CHARACTER (LEN=1), INTENT(IN) :: ch
        CHARACTER (LEN=24)            :: vtype
        ! Local variable
        INTEGER  :: i, j
        i = ICHAR(ch) - ICHAR('a') + 1
        IF (i >= 1 .AND. i <= 26) THEN
            j = var_type(i)
            vtype = vt(j)
        ELSE
            i = ICHAR(ch) - ICHAR('A') + 1
            IF (i >= 1 .AND. i <= 26) THEN
                j = var_type(i)
                vtype = vt(j)
            ELSE
                vtype = ' '
            END IF
        END IF
        RETURN
    END FUNCTION implicit_type
END MODULE implicit

PROGRAM to_f90
    USE implicit
    IMPLICIT NONE
    TYPE :: code
        CHARACTER (LEN=140)  :: text
        CHARACTER (LEN=  5)  :: label
        TYPE (code), POINTER :: next
    END TYPE code
    TYPE :: argument
        CHARACTER (LEN=10)       :: name
        INTEGER                  :: intention    ! IN = 1, OUT = 2, IN OUT = 3
        CHARACTER (LEN=24)       :: var_type     ! Room for DOUBLE PRECISION COMPLEX
        INTEGER                  :: dim          ! DIM = 0 for scalars
        CHARACTER (LEN=24)       :: dimensions   ! Not used if DIM = 0
        TYPE (argument), POINTER :: next
    END TYPE argument
    CHARACTER (LEN=60)       :: f77_name, f90_name
    CHARACTER (LEN= 1)       :: tab = CHAR(9), ch
    CHARACTER (LEN=50)       :: prog_unit_name = ' ', blank = ' ', case_expr
    CHARACTER (LEN= 9)       :: delimiters = ' =+-*/,()'
    CHARACTER (LEN=10)       :: numbers = '1234567890'
    CHARACTER (LEN= 5)       :: lab
    CHARACTER (LEN=30)       :: text, vtype
    CHARACTER (LEN=140)      :: statement
    CHARACTER (LEN= 8)       :: date
    CHARACTER (LEN=10)       :: time
    INTEGER                  :: iostatus, pos, count, last, n_marks, pos1(20),  &
        pos2(20), lab_length, indent, i, i1, i2, length, &
        numb_arg, i3, i4
    TYPE (code), POINTER     :: head, current, tail, last_line, next_line,  &
        first_decl, last_decl, start_prog_unit,  &
        end_prog_unit
    LOGICAL                  :: asterisk, OK, data_stmnt, first_arg, continuation
    TYPE (argument), POINTER :: arg_start, arg, last_arg
    INTERFACE
        SUBROUTINE mark_text(text, n_marks, pos1, pos2, continuation)
            IMPLICIT NONE
            CHARACTER (LEN = *), INTENT(IN)  :: text
            INTEGER, INTENT(OUT)             :: n_marks, pos1(:), pos2(:)
            LOGICAL, INTENT(IN)              :: continuation
        END SUBROUTINE mark_text
        SUBROUTINE convert_text(text, n_marks, pos1, pos2)
            IMPLICIT NONE
            CHARACTER (LEN = *), INTENT(IN OUT) :: text
            INTEGER, INTENT(IN)                 :: n_marks
            INTEGER, INTENT(IN OUT)             :: pos1(:), pos2(:)
        END SUBROUTINE convert_text
        SUBROUTINE remove_data_blanks(text)
            IMPLICIT NONE
            CHARACTER (LEN=*), INTENT(IN OUT) :: text
        END SUBROUTINE remove_data_blanks
        FUNCTION last_char( text ) RESULT(ch)
            IMPLICIT NONE
            CHARACTER (LEN=*), INTENT(IN) :: text
            CHARACTER (LEN=1)             :: ch
        END FUNCTION last_char
        FUNCTION find_delimited_name (text, name) RESULT(pos)
            IMPLICIT NONE
            CHARACTER (LEN=*), INTENT(IN) :: text, name
            INTEGER                       :: pos
        END FUNCTION find_delimited_name
    END INTERFACE
    DO
        WRITE(*, '(a)', ADVANCE='NO')' Enter name of Fortran source file: '
        READ(*, '(a)', IOSTAT=iostatus) f77_name
        IF (iostatus < 0) STOP               ! Halts gracefully when the names are
        ! read from a file and the end is reached
        IF (LEN_TRIM( f77_name ) == 0) CYCLE
        IF (INDEX(f77_name, '.') == 0) THEN
            last = LEN_TRIM(f77_name)
            f77_name(last+1:last+4) = '.for'
        END IF
        OPEN(8, file=f77_name, status='old', IOSTAT=iostatus)
        IF (iostatus /= 0) THEN
            WRITE(*, *) '** Unable to open file: ', f77_name
            CYCLE
        END IF
        pos = INDEX(f77_name, '.', BACK=.TRUE.)        ! Added BACK=.TRUE. for Unix
        ! names e.g. prog.test.f
        f90_name = f77_name(1:pos) // 'f90'
        OPEN(9, file=f90_name)
        !     Set up a linked list containing the lines of code
        NULLIFY(head, tail)
        ALLOCATE(head)
        tail => head
        READ(8, '(a)') head % text
        IF (head % text(1:1) == 'C' .OR. head % text(1:1) == 'c' .OR.   &
            head % text(1:1) == '*') THEN
            head % text(1:1) = '!'
        ELSE IF (head % text(1:1) == tab) THEN
            head % text = '      ' // head % text(2:)
        END IF
        head % label = ' '
        count = 1
        DO
            NULLIFY(current)
            ALLOCATE(current)
            READ(8, '(a)', IOSTAT=iostatus) current % text
            IF (iostatus /= 0) EXIT
            !     Change C, c or * in column 1 to !
            IF (current % text(1:1) == 'C' .OR. current % text(1:1) == 'c' .OR.   &
                current % text(1:1) == '*'  ) THEN
                IF (LEN_TRIM(current % text) > 1) THEN
                    current % text(1:1) = '!'
                ELSE
                    current % text = ' '           ! Leave blank if nothing else on line
                END IF
                current % label = ' '
            ELSE
                current % label = ADJUSTL(current % text(1:5))
            END IF
            count = count + 1
            IF (current % label(1:1) == tab) THEN          ! Expand tabs
                current % label = ' '
                current % text = '      ' // current % text(2:)
            ELSE IF (current % label(1:1) == '!') THEN
            current % label = ' '
        ELSE
            current % label= ADJUSTL(current % label)
        END IF
        NULLIFY(current % next)
        tail % next => current
        tail => current
    END DO
    WRITE(*, *)'No. of lines read =', count
    !---------------------------------------------------------------------------
    current => head
    NULLIFY(last_line)
    data_stmnt = .FALSE.
    DO
        !     Look for blanks in columns 1-5 followed by non-blank in column 6.
        !     If found, add an ampersand at the end of the previous line.
        IF (current % label == '     ' .AND. current % text(6:6) /= ' ' .AND.  &
            &   current % text(1:1) /= '!') THEN
            last = LEN_TRIM(last_line % text)
            last_line % text(last+3:last+3) = '&'
            current % text(6:6) = ' '
            continuation = .TRUE.
        ELSE
            data_stmnt = .FALSE.
            continuation = .FALSE.
        END IF
        !     Replace tabs with single spaces
        DO
            pos = INDEX(current % text, tab)
            IF (pos == 0) EXIT
            current % text(pos:pos) = ' '
        END DO
        !     Remove leading blanks
        current % text = ADJUSTL(current % text)
        !     Mark regions of text which must not have their case changed.
        CALL mark_text(current % text, n_marks, pos1, pos2, continuation)
        !     Convert cases of regions which are not protected.
        CALL convert_text(current % text, n_marks, pos1, pos2)
        !     If line is start of a program unit, record its name
        IF (current % text(1:7) == 'PROGRAM') THEN
            prog_unit_name = current % text(1:50)
        ELSE IF (current % text(1:10) == 'SUBROUTINE') THEN
            pos = INDEX(current % text, '(') - 1
            IF (pos < 0) pos = LEN_TRIM(current % text)
            prog_unit_name = current % text(1:pos)
        ELSE IF (current % text(1:9) == 'BLOCKDATA') THEN
            prog_unit_name = current % text(1:50)
        ELSE
            ! N.B. 'FUNCTION' could be part of a comment
            pos = INDEX(current % text, 'FUNCTION')
            IF (pos > 0 .AND. INDEX(current % text, '!') == 0 .AND.        &
            INDEX(current % text, "'") == 0) THEN
                last = INDEX(current % text, '(') - 1
                IF (last < 0) last = LEN_TRIM(current % text)
                prog_unit_name = current % text(pos:last)
            END IF
        END IF
    !     If first word is one of INTEGER, REAL, DOUBLE PRECISION, CHARACTER ,
    !     LOGICAL or COMPLEX, add :: unless FUNCTION appears on the same line
    !     or next non-blank character is '*' as in REAL*8.
        IF (INDEX(current % text, 'FUNCTION') == 0) THEN
            pos = 0
            IF (INDEX(current % text, 'INTEGER') == 1) THEN
                pos = 9
            ELSE IF (INDEX(current % text, 'REAL') == 1) THEN
                pos = 6
            ELSE IF (INDEX(current % text, 'DOUBLE PRECISION') == 1) THEN
                pos = 18
            ELSE IF (INDEX(current % text, 'CHARACTER') == 1) THEN
                pos = 11
            ELSE IF (INDEX(current % text, 'COMPLEX') == 1) THEN
                pos = 9
            ELSE IF (INDEX(current % text, 'LOGICAL') == 1) THEN
                pos = 9
            ELSE IF (INDEX(current % text, 'DOUBLE COMPLEX') == 1) THEN
                pos = 16
            END IF
            IF (pos > 0) THEN
                asterisk = INDEX(current % text(pos-1:pos), '*') > 0
                IF (.NOT. asterisk) THEN
                    IF (pos /= 11) THEN
                        current % text = current % text(1:pos-1) // ':: ' //  &
                            ADJUSTL( current % text(pos:) )
                    ELSE                         ! CHARACTER type, default length = 1
                        current % text = 'CHARACTER (LEN=1) :: ' //   &
                            ADJUSTL( current % text(pos:) )
                    END IF
                ELSE
                    IF (pos == 11) THEN          ! CHARACTER * found
                        i1 = INDEX(current % text, '*') + 1
                        length = LEN_TRIM(current % text)
                        ! Get length, could be (*)
                        DO
                            IF (current % text(i1:i1) /= ' ') EXIT
                            IF (i1 >= length) EXIT
                            i1 = i1 + 1
                        END DO
                        IF (current % text(i1:i1) == '(') THEN
                            i1 = i1 + 1
                            i2 = INDEX(current % text, ')') - 1
                        ELSE
                            i2 = INDEX(current % text(i1:), ' ') + i1 - 2
                        END IF
                        current % text = 'CHARACTER (LEN=' // current % text(i1:i2) //  &
                            ') :: ' // ADJUSTL( current % text(i2+2:) )
                    END IF
                END IF
                ! Check for 2 or more lengths in CHARACTER declaration.
                ! e.g. CHARACTER a, b, c*10, d
                ! Put 2nd (& later) declarations on separate lines:
                ! CHARACTER*10 c
                ! But check for CHARACTER*10 a(*) where last * is not a
                ! length but a dimension
                IF (pos == 11) THEN
                    pos = INDEX(current % text, '::') + 2
                    DO
                        i = INDEX(current % text(pos:), '*')
                        IF (i == 0) EXIT
                        i = i + pos - 1
                        length = LEN_TRIM(current % text)
                        i1 = INDEX(current % text(:i-1), ',', BACK=.TRUE.)
                        i1 = MAX(pos, i1)
                        i2 = INDEX(current % text(i+1:), ',')
                        IF (i2 == 0) THEN
                            i2 = length + 1
                        ELSE
                            i2 = i2 + i
                        END IF
                        ! i1, i2 mark commas at beginning & end of `, name*xx,'
                        ! but we could have `name(xx, *), '
                        ! Test for * after ( , or ) before ,
                        i3 = INDEX(current % text(i1:i2), '(')
                        i4 = INDEX(current % text(i1:), ')')
                        IF (i3 > 0)  THEN
                            i4 = i4 + i1 - 1
                            i2 = INDEX(current % text(i4+1:), ',')
                            IF (i2 == 0) THEN
                                i2 = length + 1
                            ELSE
                                i2 = i2 + i4
                            END IF
                            pos = i2 + 1
                            CYCLE
                        ELSE IF (i4 > 0) THEN
                            i4 = i4 + i1 - 1
                            i2 = INDEX(current % text(i4+1:), ',')
                            IF (i2 == 0) THEN
                                i2 = length + 1
                            ELSE
                                i2 = i2 + i4
                            END IF
                            pos = i2 + 1
                            CYCLE
                        END IF
                        IF (i1 == pos .AND. i2 == length + 1) THEN
                            ! Only one declaration left on line, e.g.
                            ! CHARACTER :: name*50
                            current % text = 'CHARACTER (LEN=' // current % text(i+1:length) &
                                // ') :: ' // ADJUSTL( current % text(i1:i-1) )
                            EXIT
                        END IF
                        ALLOCATE( next_line )
                        next_line % next => current % next
                        current % next => next_line
                        next_line % text = 'CHARACTER' // current % text(i:i2-1) //  &
                            ' ' // current % text(i1+1:i-1)
                        IF (i2 < length) THEN
                            current % text = current % text(:i1) // current % text(i2+1:length)
                        ELSE
                            current % text = current % text(:i1-1)
                        END IF
                    END DO
                END IF
            END IF
        END IF
        !     If this is in a DATA statement, eliminate any blanks within numbers
        IF (data_stmnt .OR. current % text(1:4) == 'DATA') THEN
            CALL remove_data_blanks(current % text)
            last = LEN_TRIM(current % text)
            data_stmnt = .TRUE.
        END IF
        !     If line only contains 'END', add the program unit name
        IF (LEN_TRIM(current % text) == 3 .AND. current % text(1:3) == 'END') THEN
            current % text = current % text(1:3) // ' ' // prog_unit_name
            prog_unit_name = ' '
            !     Convert `enddo' to 'END DO'
        ELSE IF (current % text(1:5) == 'enddo') THEN
            current % text = 'END DO' // current % text(6:)
        END IF
        last_line => current
        IF (ASSOCIATED(current, tail)) EXIT
        IF (.NOT. ASSOCIATED(current)) EXIT
        current => current % next
    END DO
    !-------------------------------------------------------------------------
    !     Now convert Do-loops
    current => head
    WRITE(*, *) '      Converting DO-loops, 3-way IFs, & computed GO TOs'
    DO
        IF (current % text(1:1) /= '!' .AND. current % text(1:1) /= ' ') THEN
        pos = INDEX(current % text, 'DO')
        IF ( pos > 0 .AND. (current % text(pos+2:pos+2) == ' ' .OR.  &
            current % text(pos+2:pos+2) == ',' ) ) THEN
            IF ( current % text(pos+2:pos+2) == ',' )  &
                current % text(pos+2:pos+2) = ' '
            IF (pos == 1) THEN
                OK = .TRUE.
            ELSE IF (SCAN(current % text(pos-1:pos-1), delimiters) > 0) THEN
                OK = INDEX(current % text(:pos-1), 'END ') == 0
            ELSE
                OK = .FALSE.
            END IF
            IF (OK) THEN
                text = ADJUSTL( current % text(pos+3:) )
                last = INDEX( text, ' ')
                lab = text(:last-1)
                IF (SCAN(lab(1:1), numbers) == 0) lab = ' '
                lab_length = LEN_TRIM(lab)
                IF (lab_length > 0) THEN
                    pos = INDEX(lab, ',')      ! Check for a comma after label
                    IF (pos > 0) THEN
                        lab(pos:) = ' '
                        i = INDEX(current % text, ',')
                        current % text(i:i) = ' '
                        lab_length = pos - 1
                    END IF
                    CALL do_loop_fixup(current, lab)
                END IF
            END IF
            ! Test for computed GO TO
        ELSE IF (INDEX(current % text, 'GO TO') > 0) THEN
            i1 = INDEX(current % text, 'GO TO')
            statement = ADJUSTL(current % text(i1+5:))
            ! Test for a `('
            IF (statement(1:1) == '(') THEN
                OK = .TRUE.
                ! If current line is continued, try appending
                ! the next line
                IF (last_char(statement) == '&') THEN
                    next_line => current % next
                    length = LEN_TRIM(statement) + LEN_TRIM(next_line % text)
                    OK = (length <= 141) .AND. (last_char(next_line % text) /= '&')
                    IF (OK) THEN
                        pos = LEN_TRIM(statement)
                        statement = TRIM(statement(:pos-1)) // TRIM(next_line % text)
                        current % next => next_line % next
                        DEALLOCATE( next_line )
                    END IF
                END IF
                IF (OK) THEN
                    ! Check for comma between ( and )
                    pos = INDEX(statement, ')')
                    IF (INDEX(statement(2:pos-1), ',') > 0) THEN
                        ! We could have something like:
                        ! IF (condition) GO TO (100, 200, 300) ivar
                        ! Before doing any more, split into 3 lines:
                        ! IF (condition) THEN
                        ! GO TO (100, 200, 300) ivar
                        ! END IF
                        IF (current % text(1:2) == 'IF') THEN
                            IF (current % text(3:3) == ' ' .OR.  &
                                current % text(3:3) == '(') THEN
                                current % text = current % text(:i1-1) // 'THEN'
                                i1 = 2
                                CALL insert_and_moveto_newline(current)
                                current % text = ' '
                                next_line => current
                                CALL insert_and_moveto_newline(next_line)
                                next_line % text = 'END IF'
                            END IF
                        END IF
                        ! Get the CASE variable or expression
                        case_expr = ADJUSTL(statement(pos+1:))
                        IF (case_expr(1:1) == ',') case_expr = ADJUSTL(case_expr(2:))
                        current % text = current % text(:i1-1) // 'SELECT CASE ( ' // &
                            TRIM(case_expr) // ' )'
                        ! Put in pairs of lines:  CASE ( i )
                        !                         GO TO i-th label
                        CALL goto_cases(statement(2:pos-1))
                    END IF
                END IF
            END IF
            ! Look for IF, then a number as last non-blank character
        ELSE
            pos = INDEX(current % text, 'IF')
            IF (pos > 0) THEN
                last = LEN_TRIM(current % text)
                IF (SCAN(current % text(last:last), numbers) > 0) THEN
                    CALL fix_3way_IF(current)
                END IF
            END IF
        END IF
    END IF
    IF (ASSOCIATED(current, tail)) EXIT
    IF (.NOT. ASSOCIATED(current)) EXIT
    current => current % next
END DO
!-------------------------------------------------------------------------
!     Determine INTENTs for dummy arguments
WRITE(*, *) '      Determining INTENTs of dummy arguments'
!     Search for either FUNCTION or SUBROUTINE.
!     Extract name of program unit.
current => head
NULLIFY(last_line)
outer_loop: DO
    DO
        IF (current % text(1:1) /= '!' .AND. current % text(1:1) /= ' ') THEN
        IF (current % text(1:10) == 'SUBROUTINE') THEN
            pos = INDEX(current % text, '(') - 1
            IF (pos < 0) pos = LEN_TRIM(current % text)
            prog_unit_name = current % text(1:pos)
            EXIT
        ELSE
            pos = INDEX(current % text, 'FUNCTION')
            IF (pos > 0) THEN
                last = INDEX(current % text, '(') - 1
                IF (last < 0) last = LEN_TRIM(current % text)
                prog_unit_name = current % text(pos:last)
                EXIT
            END IF
        END IF
    END IF
    last_line => current
    current => current % next
    IF (ASSOCIATED(current, tail)) EXIT outer_loop
END DO
!     If there is no blank line between this program unit and the previous
!     one, then insert one.
IF (ASSOCIATED(last_line)) THEN
    IF (LEN_TRIM(last_line % text) > 0) THEN
        CALL insert_and_moveto_newline(last_line)
        last_line % text = ' '
    END IF
END IF
ALLOCATE( start_prog_unit )
start_prog_unit => current
!     Find end of program unit
DO
    current => current % next
    IF (current % text(1:1) /= '!' .AND. current % text(1:1) /= ' ') THEN
    IF (current % text(1:3) == 'END') THEN
        IF (INDEX(current % text(5:), prog_unit_name) > 0) THEN
            ALLOCATE( end_prog_unit )
            end_prog_unit => current
            EXIT
        END IF
    END IF
END IF
IF (ASSOCIATED(current, tail)) EXIT outer_loop
    END DO
    !     Find first & last declarations
    ALLOCATE( first_decl, last_decl )
    CALL find_declarations( start_prog_unit, end_prog_unit, first_decl, &
        last_decl )
    IF (.NOT. ASSOCIATED(last_decl)) GO TO 100
    !     Extract list of dummy arguments
    CALL get_arg_list()
    IF (numb_arg == 0) GO TO 100
    !     See if the declarations contain any IMPLICIT statements
    CALL reset_defaults()
    current => first_decl
    DO
        IF( current % text(1:8) == 'IMPLICIT' ) THEN
            statement = current % text(10:)
            CALL set_implicit_types(statement)
        END IF
        IF (ASSOCIATED(current, last_decl)) EXIT
        current => current % next
    END DO
    !     Search through the declarations for variable types & dimensions
    CALL get_var_types()
    !     Search through rest of code to try to determine the INTENTs
    CALL get_intents()
    !     Insert INTENT statements
    statement = first_decl % text
    first_decl % text = ' '
    current => first_decl
    arg => arg_start
    DO
        CALL insert_and_moveto_newline(current)
        current % text = arg % var_type
        SELECT CASE (arg % intention)
        CASE (0, 3)
            current % text = TRIM(current % text) // ', INTENT(IN OUT)'
        CASE (1)
            current % text = TRIM(current % text) // ', INTENT(IN)'
        CASE (2)
            current % text = TRIM(current % text) // ', INTENT(OUT)'
        END SELECT
        current % text = current % text(:41) // ':: ' // arg % name
        IF (arg % dim > 0)  &
            current % text = TRIM(current % text) // arg % dimensions
        IF (ASSOCIATED(arg, last_arg)) EXIT
        arg => arg % next
    END DO
    CALL insert_and_moveto_newline(current)
    current % text = statement
    !     Search for, and convert, any PARAMETER statements
    current => first_decl
    DO
        IF (current % text(1:9) == 'PARAMETER') THEN
            CALL convert_parameter(current)
        END IF
        IF (ASSOCIATED(current, last_decl)) EXIT
        current => current % next
    END DO
    !     Insert a blank line after the last declaration if there is not one
    !     there already, or a comment.
    next_line => last_decl % next
    IF (next_line % text(1:1) /= ' ' .AND. next_line % text(1:1) /= '!') THEN
    CALL insert_and_moveto_newline(last_decl)
    last_decl % text = ' '
END IF
!     Move onto the next SUBROUTINE or FUNCTION
100 current => end_prog_unit
IF (ASSOCIATED(current, tail)) EXIT
last_line => current
current => current % next
IF (ASSOCIATED(current, tail)) EXIT
  END DO outer_loop
  !-------------------------------------------------------------------------
  !     Indenting and writing output file
  !     Output header line & any continuation lines
  current => head
  continuation = .FALSE.
  DO
      IF (continuation) THEN
          WRITE(9, '(t9, a)') TRIM(current % text)
      ELSE
          WRITE(9, '(a)') TRIM(current % text)
      END IF
      ch = last_char(current % text)
      current => current % next
      IF (ch /= '&') EXIT
      continuation = .TRUE.
  END DO
  !                                      Date & time stamp
  CALL DATE_AND_TIME(date, time)
  IF (ch /= ' ') WRITE(9, *)
  WRITE(9, '("! Code converted using TO_F90 by Alan Miller")')
  WRITE(9, '("! Date: ", a4, "-", a2, "-", a2, "  Time: ", a2, ":", a2,  &
  &    ":", a2)') date(1:4), date(5:6), date(7:8), time(1:2),      &
      time(3:4), time(5:6)
  IF (LEN_TRIM(current % text) > 0) WRITE(9, *)
  indent = 0
  continuation = .FALSE.
  WRITE(*, *) '      Writing file: ', f90_name
  DO
      IF (current % text(1:1) /= '!') THEN
      IF (INDEX(current % text, 'END ') > 0) THEN
          IF (INDEX(current % text, 'END SELECT') == 0) indent = MAX(indent-2, 0)
          WRITE(9, '(a)') blank(:indent) // TRIM(current % text)
          continuation = (last_char(current % text) == '&')
      ELSE IF (INDEX(current % text, 'DO ') > 0) THEN
          WRITE(9, '(a)') blank(:indent) // TRIM(current % text)
          continuation = (last_char(current % text) == '&')
          indent = indent + 2
          ! Temporary reduction in
          ! indentation for `ELSE'
      ELSE IF (INDEX(current % text, 'ELSE') > 0) THEN
          last = MAX(0, indent-2)
          WRITE(9, '(a)') blank(:last) // TRIM(current % text)
          continuation = (last_char(current % text) == '&')
          ! Indent increased if `IF'
          ! is followed by `THEN'
      ELSE IF (INDEX(current % text, 'IF ') > 0 .OR.           &
          INDEX(current % text, 'IF(') > 0) THEN
          current % text =  blank(:indent) // TRIM(current % text)
          ! If IF statement runs onto
          ! next line, try joining
          last = LEN_TRIM(current % text)
          IF (current % text(last:last) == '&') THEN
              next_line => current % next
              IF (last + LEN_TRIM(next_line % text) < 80) THEN
                  current % text(last:last) = ' '
                  current % text = TRIM(current % text) // ' ' //  &
                      TRIM(next_line % text)
                  current % next => next_line % next
              END IF
          END IF
          WRITE(9, '(a)') TRIM(current % text)
          continuation = (last_char(current % text) == '&')
          next_line => current
          DO
              IF (INDEX(next_line % text, ' THEN') > 0 .OR.  &
                      INDEX(next_line % text, ')THEN') > 0) THEN
                      indent = indent + 2
                      EXIT
                  ELSE
                      IF ( last_char(next_line % text) /= '&') EXIT
                  END IF
                  next_line => next_line % next
              END DO
          ELSE
              !     If line ends with '&', attempt to join on the next line if it is short.
              last = LEN_TRIM(current % text)
              IF (last > 0) THEN
                  IF (current % text(last:last) == '&') THEN
                      last = LEN_TRIM(current % text(:last-1))
                      next_line => current % next
                      IF (last + indent + LEN_TRIM(next_line % text) < 78) THEN
                          current % text = current % text(:last) // ' ' // &
                              TRIM(next_line % text)
                          current % next => next_line % next
                          DEALLOCATE(next_line)
                      END IF
                  END IF
              END IF
              IF (continuation) THEN
                  WRITE(9, '(a)') blank(:indent+4) // TRIM(current % text)
              ELSE
                  WRITE(9, '(a)') blank(:indent) // TRIM(current % text)
              END IF
              continuation = (last_char(current % text) == '&')
          END IF
          !     Comment line (unchanged)
      ELSE
          WRITE(9, '(a)') TRIM(current % text)
          continuation = .FALSE.
      END IF
      IF (ASSOCIATED(current, tail)) EXIT
      IF (.NOT. ASSOCIATED(current)) EXIT
      current => current % next
  END DO

  call execute_command_line('sed -i "s/REAL(::/REAL(/g" '//f90_name)
  write(*,*)'sed -i "s/REAL(::/REAL(/g" '//f90_name
  call execute_command_line('sed -i "s/DOUBLE PRECISION/REAL(kind=8)/g" '//f90_name)
  write(*,*)'sed -i "s/DOUBLE PRECISION/REAL(kind=8)/g" '//f90_name
  call execute_command_line('sed -i "s/DOUBLE COMPLEX/COMPLEX(kind=8)/g" '//f90_name)
  write(*,*)'sed -i "s/DOUBLE COMPLEX/COMPLEX(kind=8)/g" '//f90_name
  call execute_command_line('sed -i "s/\w*\s::$/ /g" '//f90_name)
  write(*,*)'sed -i "s/\w*\s::/ /g" '//f90_name
  CLOSE(8)
  CLOSE(9)
END DO

STOP
CONTAINS
    SUBROUTINE do_loop_fixup(start, lab)
        !     Convert DO-loops from:    DO xxx i=1,n    To:   DO i=1,n
        !                           xxx CONTINUE              END DO
        !     `start' points to the first line of the DO loop
        !     `lab' is the label
        TYPE (code), POINTER          :: start
        CHARACTER (LEN=*), INTENT(IN) :: lab
        !     Local variables
        TYPE (code), POINTER :: current, end_loop
        INTEGER              :: i, j, level, nmult, nl_length
        LOGICAL              :: continued, jump_from_inner, referenced
        CHARACTER (LEN=5)    :: label(20), next_label, text
        CHARACTER (LEN=10)   :: loop_name
        !-------------------------------------------------------------------
        ! PASS 1. Analysis
        !    Find end of loop (end_loop)
        !    Test for multiple loops using same label
        !    Test for jumps to end of this loop from this DO loop (referenced)
        !         or from inner loops (jump_from_inner)
        !    Find if label is on a statement other than CONTINUE
        !    Find if next executable line beyond loop is labelled (for EXIT)
        current => start % next
        nmult = 1
        level = 0
        jump_from_inner = .FALSE.
        referenced = .FALSE.
        DO
            IF (current % label == lab) THEN
                continued = (INDEX(current % text, 'CONTINUE') > 0)
                EXIT
            END IF
            ! Check for nested DO loop or multiple use of current loop
            IF (current % text(1:1) == '!' .OR. current % text(1:1) == ' ') GO TO 20
            i = INDEX(current % text, 'DO ')
            IF (i > 0 .AND. INDEX(current % text, 'END DO') == 0) THEN
                text = ADJUSTL(current % text(i+3:))
                IF (SCAN(text(1:1), numbers) > 0) THEN
                    IF (text(:lab_length) == lab) THEN
                        nmult = nmult + 1
                    ELSE
                        level = level + 1
                        i = SCAN(text, ' ,')
                        IF (i > 0) text = text(:i-1)
                        label(level) = text
                    END IF
                END IF
            END IF
            ! Check for end of nested loop
            IF (current % label /= '     ' .AND. level > 0) THEN
                DO
                    IF (current % label == label(level)) THEN
                        level = level - 1
                        IF (level <= 0) EXIT
                    ELSE
                        EXIT
                    END IF
                END DO
            END IF
            ! Test for GO TO current loop label
            i = INDEX(current % text, 'GO TO')
            IF (i > 0) THEN
                text = ADJUSTL(current % text(i+5:))
                IF (text(:lab_length) == lab) THEN
                    IF (level > 0) THEN
                        jump_from_inner = .TRUE.
                    ELSE
                        referenced = .TRUE.
                    END IF
                END IF
            END IF
            ! Get next line
            20 IF (.NOT. ASSOCIATED(current)) RETURN
            current => current % next
        END DO
        end_loop => current
        ! Find label of next executable line.
        ! First advance past any continuation lines after the end of the DO loop.
        next_label = ' '
        DO
            IF (last_char(current % text) /= '&') EXIT
            IF (.NOT. ASSOCIATED(current)) GO TO 10
            current => current % next
        END DO

        DO
            current => current % next
            IF (current % text(1:1) /= '!') EXIT
            IF (.NOT. ASSOCIATED(current)) GO TO 10
        END DO
        next_label = current % label
        nl_length = LEN_TRIM(next_label)
        !-------------------------------------------------------------------
        ! PASS 2. Transform beginning & end of loop
        10 current => start
        ! Remove label from DO line
        ! There may be a comma after the label, if so, remove it.
        i = INDEX(current % text, lab(:lab_length))
        current % text = current % text(:i-1) // current % text(i+lab_length:)
        length = LEN_TRIM(current % text)
        DO j = i, length
            IF (current % text(j:j) == ' ') CYCLE
            IF (current % text(j:j) == ',') current % text(j:j) = ' '
            EXIT
        END DO
        ! Jump out of inner loop detected, set up DO construct.
        IF (jump_from_inner) THEN
            loop_name = 'loop' // lab
            current % text = TRIM(loop_name) // ':  ' // current % text
            current % label = ' '
        END IF
        ! Insert `END DO' at end of loop
        current => end_loop
        IF (continued) THEN
            current % text = 'END DO'
            current % label = ' '
        ELSE
            IF (.NOT. referenced) THEN
                current % label = ' '
                i = INDEX(current % text, lab(:lab_length))
                IF (i > 0) current % text = ADJUSTL(current % text(i+lab_length:))
            END IF
            ! If there are continuation lines, advance to last one
            DO
                IF (last_char(current % text) == '&') THEN
                    current => current % next
                ELSE
                    EXIT
                END IF
            END DO
            CALL insert_and_moveto_newline(current)
            end_loop => current
            current % text = 'END DO'
        END IF
        IF (jump_from_inner) current % text = TRIM(current % text) // ' ' // loop_name
        ! Insert multiple CONTINUE's if necessary
        IF (nmult > 1) THEN
            CALL insert_and_moveto_newline(current)
            end_loop => current
            current % text = lab // ' CONTINUE'
            current % label = lab
        END IF
        !-------------------------------------------------------------------
        ! PASS 3. Change GO TOs to CYCLE or EXIT where appropriate
        current => start % next
        IF (continued) THEN
            DO
                IF (current % text(1:1) == '!' .OR. current % text(1:1) == ' ') GO TO 30
                i = INDEX(current % text, 'GO TO')
                IF (i > 0) THEN
                    text = ADJUSTL(current % text(i+5:))
                    IF (text(:5) == lab) THEN
                        current % text(i:) = 'CYCLE'
                        IF (jump_from_inner)  &
                            current % text = TRIM(current % text) // ' ' // loop_name
                    ELSE IF (nl_length > 0 .AND. text(:nl_length) == next_label) THEN
                        current % text(i:) = 'EXIT'
                        IF (jump_from_inner)  &
                            current % text = TRIM(current % text) // ' ' // loop_name
                    END IF
                END IF
                ! Get next line
                30 current => current % next
                IF (ASSOCIATED(current, end_loop)) EXIT
                IF (.NOT.ASSOCIATED(current)) EXIT
            END DO
        END IF
        RETURN
    END SUBROUTINE do_loop_fixup

    SUBROUTINE fix_3way_IF(start)
        !     Convert 3-way IFs to IF () THEN .. ELSE IF () THEN .. ELSE
        TYPE (code), POINTER :: start
        !     Local variables
        TYPE (code), POINTER :: current
        INTEGER              :: pos1, count, length, pos2, i, lab1, lab2, lab3, lenq, &
            next_label, lenz
        CHARACTER (LEN=1)    :: ch
        CHARACTER (LEN=128)  :: quantity
        CHARACTER (LEN=3)    :: zero_txt
        current => start
        length = LEN_TRIM(current % text)
        !     Find closing bracket to match the opening bracket.
        !     Only cases with the closing bracket on the same line are converted.
        pos1 = INDEX(current % text, 'IF')
        !     Check that next non-blank character after 'IF' is '('.
        i = pos1 + 2
        DO
            ch = current % text(i:i)
            IF (ch /= ' ') EXIT
            i = i + 1
            IF (i > length) RETURN
        END DO
        IF (ch /= '(') RETURN
        pos1 = i
        count = 1
        pos2 = pos1 + 1
        DO
            i = SCAN(current % text(pos2:length), '()')
            IF (i == 0) RETURN
            pos2 = i + pos2 - 1
            IF (current % text(pos2:pos2) == '(') THEN
                count = count + 1
            ELSE
                count = count - 1
            END IF
            IF (count == 0) EXIT
            pos2 = pos2 + 1
        END DO
        !     See if there are 3 labels after the closing bracket.
        READ(current % text(pos2+1:), *, ERR=100) lab1, lab2, lab3
        !     As it is probably very old code, the first alphabetic character in the
        !     expression should tell us whether the quantity is REAL or INTEGER.
        DO i = pos1+1, pos2-1
            ch = current % text(i:i)
            IF (ch >= 'i' .AND. ch <= 'n') THEN
                zero_txt = '0'
                lenz = 1
                EXIT
            ELSE IF (ch >= 'a' .AND. ch <= 'z') THEN
                zero_txt = '0.0'
                lenz = 3
                EXIT
            ELSE IF (i == pos2-1) THEN
                RETURN
            END IF
        END DO
        quantity = current % text(pos1:pos2)
        lenq = LEN_TRIM(quantity)
        !     Find the next executable line to see if it is labelled.
        next_label = 0
        DO
            IF (.NOT. ASSOCIATED(current)) EXIT
            current => current % next
            IF (current % text(1:1) == '!' .OR. LEN_TRIM(current % text) == 0) CYCLE
            IF (LEN_TRIM(current % label) > 0) READ(current % label, *) next_label
            EXIT
        END DO
        current => start
        IF (lab1 == lab2) THEN
            current % text = current % text(:pos2-1) // ' > ' // zero_txt(:lenz) //  &
                ') THEN'
                CALL insert_and_moveto_newline(current)
                current % text = ' '
                WRITE(current % text, '(a, i5)') 'GO TO ', lab3
                IF (lab1 /= next_label) THEN
                    CALL insert_and_moveto_newline(current)
                    current % text = 'ELSE'
                    CALL insert_and_moveto_newline(current)
                    current % text = ' '
                    WRITE(current % text, '(a, i5)') 'GO TO ', lab1
                END IF
                CALL insert_and_moveto_newline(current)
                current % text = 'END IF'
            ELSE IF (lab2 == lab3) THEN
                current % text = current % text(:pos2-1) // ' < ' // zero_txt(:lenz) //  &
                    ') THEN'
                    CALL insert_and_moveto_newline(current)
                    current % text = ' '
                    WRITE(current % text, '(a, i5)') 'GO TO ', lab1
                    IF (lab2 /= next_label) THEN
                        CALL insert_and_moveto_newline(current)
                        current % text = 'ELSE'
                        CALL insert_and_moveto_newline(current)
                        current % text = ' '
                        WRITE(current % text, '(a, i5)') 'GO TO ', lab2
                    END IF
                    CALL insert_and_moveto_newline(current)
                    current % text = 'END IF'
                ELSE IF (lab1 == lab3) THEN
                    current % text = current % text(:pos2-1) // ' == ' // zero_txt(:lenz) //  &
                        ') THEN'
                        CALL insert_and_moveto_newline(current)
                        current % text = ' '
                        WRITE(current % text, '(a, i5)') 'GO TO ', lab2
                        IF (lab1 /= next_label) THEN
                            CALL insert_and_moveto_newline(current)
                            current % text = 'ELSE'
                            CALL insert_and_moveto_newline(current)
                            current % text = ' '
                            WRITE(current % text, '(a, i5)') 'GO TO ', lab1
                        END IF
                        CALL insert_and_moveto_newline(current)
                        current % text = 'END IF'
                    ELSE
                        current % text = current % text(:pos2-1) // ' < ' // zero_txt(:lenz) //  &
                            ') THEN'
                            CALL insert_and_moveto_newline(current)
                            current % text = ' '
                            WRITE(current % text, '(a, i5)') 'GO TO ', lab1
                            CALL insert_and_moveto_newline(current)
                            current % text = 'ELSE IF ' // quantity(1:lenq-1) // ' == ' // &
                                zero_txt(:lenz) // ') THEN'
                                CALL insert_and_moveto_newline(current)
                                current % text = ' '
                                WRITE(current % text, '(a, i5)') 'GO TO ', lab2
                                IF (lab3 /= next_label) THEN
                                    CALL insert_and_moveto_newline(current)
                                    current % text = 'ELSE'
                                    CALL insert_and_moveto_newline(current)
                                    current % text = ' '
                                    WRITE(current % text, '(a, i5)') 'GO TO ', lab3
                                END IF
                                CALL insert_and_moveto_newline(current)
                                current % text = 'END IF'
                            END IF
                            100 RETURN
                        END SUBROUTINE fix_3way_IF
                        SUBROUTINE insert_and_moveto_newline(current)
                            ! Insert a new line AFTER the current line, and move `current' to point to it.
                            TYPE (code), POINTER :: current
                            !     Local variable
                            TYPE (code), POINTER :: new_line
                            ALLOCATE(new_line)
                            new_line % next => current % next
                            current % next => new_line
                            current => new_line
                            RETURN
                        END SUBROUTINE insert_and_moveto_newline
                        SUBROUTINE find_declarations( start, tail, first_decl, last_decl )
                            ! Find the first & last declaration lines in a program unit.
                            integer,parameter::arr_len=14
                            integer,parameter::dec_len=14
                            TYPE (code), POINTER :: start, tail
                            TYPE (code), POINTER :: first_decl, last_decl
                            ! Local variables
                            CHARACTER (LEN=dec_len), PARAMETER :: declaration(arr_len) =&
                                & (/ 'IMPLICIT      ', 'INTEGER       ', &
                                'REAL          ', 'DOUBLE        ', 'LOGICAL       ', &
                                'COMPLEX       ', 'DIMENSION     ', 'EXTERNAL      ', &
                                'DATA          ', 'COMMON        ', 'PARAMETER     ', &
                                'SAVE          ', 'CHARACTER     ', 'DOUBLE COMPLEX'/)
                            TYPE (code), POINTER         :: current
                            INTEGER                      :: pos, length, i
                            NULLIFY( first_decl, last_decl )
                            ! Search for first declaration
                            current => start % next
                            search1: DO
                                IF ( current % text(1:1) /= '!' .AND.  current % text(1:1) /= ' ' ) THEN
                                pos = SCAN( current % text(1:dec_len), delimiters )
                                IF (pos > 0) THEN
                                    length = MIN(dec_len, pos - 1)
                                    IF (length >= 4) THEN
                                        DO i = 1,arr_len
                                            IF ( current % text(:length) == declaration(i)(:length) ) THEN
                                                first_decl => current
                                                EXIT search1
                                            END IF
                                        END DO
                                    END IF
                                END IF
                            END IF
                            current => current % next
                            IF ( ASSOCIATED( current, tail ) ) RETURN
                        END DO search1
                        ! Search for last declaration
                        last_decl => first_decl
                        DO
                            IF ( current % text(1:1) /= '!' .AND.  current % text(1:1) /= ' ' ) THEN
                            pos = INDEX( current % text, '=' )
                            IF (pos > 0) THEN
                                IF (pos < 12) RETURN
                                IF (current % text(1:9) /= 'PARAMETER' .AND.  &
                                    current % text(1:9) /= 'CHARACTER') RETURN
                            END IF
                            IF ( current % text(1:4) == 'CALL' ) RETURN
                            IF ( current % text(1:2) == 'IF' ) THEN
                                IF ( current % text(3:3) == ' ' ) RETURN
                                IF ( current % text(3:3) == '(' ) RETURN
                            END IF
                            IF ( current % text(1:3) == 'DO ' ) RETURN
                            ! Skip continuation lines
                            DO
                                IF ( last_char(current % text) /= '&' ) EXIT
                                current => current % next
                            END DO
                            last_decl => current
                        END IF
                        current => current % next
                        IF ( ASSOCIATED( current, tail ) ) RETURN
                    END DO
                    RETURN
                END SUBROUTINE find_declarations
                SUBROUTINE get_arg_list()
                    ! Extract list of dummy arguments
                    ! Local variables
                    INTEGER :: pos, last
                    current => start_prog_unit
                    numb_arg = 0
                    DO                                 ! Find '(' if there are any arguments
                        pos = INDEX( current % text, '(')
                        IF (pos == 0) THEN
                            IF ( last_char( current % text ) /= '&' ) RETURN
                            current => current % next
                        ELSE
                            EXIT
                        END IF
                    END DO
                    pos = pos + 1
                    NULLIFY( arg_start )
                    ALLOCATE( arg_start )
                    first_arg = .TRUE.
                    DO                                 ! Loop through lines of arguments
                        last = SCAN(current % text(pos:), ',)')
                        IF (last == 0) THEN
                            IF (last_char( current % text ) /= '&' ) EXIT
                            current => current % next
                            pos = 1
                        ELSE
                            last = last + pos - 1
                            NULLIFY( arg )
                            ALLOCATE( arg )
                            IF (first_arg) THEN
                                IF (LEN_TRIM(current % text(pos:last-1)) == 0) EXIT
                                arg_start => arg
                                first_arg = .FALSE.
                                NULLIFY( last_arg )
                                ALLOCATE( last_arg )
                            ELSE
                                last_arg % next => arg
                            END IF
                            numb_arg = numb_arg + 1
                            last_arg => arg
                            arg % name = ADJUSTL( current % text(pos:last-1) )
                            arg % intention = 0
                            arg % var_type = ' '
                            arg % dim = 0
                            pos = last + 1
                        END IF
                    END DO
                    RETURN
                END SUBROUTINE get_arg_list
                SUBROUTINE get_var_types()
                    ! Search thru the declarations for the types of dummy arguments
                    current => first_decl
                    DO
                        text = current % text(:30)
                        !IF (text(:4) == 'REAL' .OR. text(:7) == 'INTEGER' .OR.     &
                        !    text(:6) == 'DOUBLE' .OR. text(:9) == 'CHARACTER' .OR. &
                        !    text(:7) == 'LOGICAL' .OR. text(:7) == 'COMPLEX') THEN
                        IF (text(:4) == 'REAL' .OR. text(:7) == 'INTEGER' .OR.     &
                            text(:8) == 'DOUBLE P' .OR. text(:9) == 'CHARACTER' .OR. &
                            text(:7) == 'LOGICAL' .OR. text(:7) == 'COMPLEX' .OR. &
                            text(:8) == 'DOUBLE C') THEN
                            ! Copy the variable type to vtype
                            last = INDEX(text, ' ::') - 1
                            IF (last < 0) THEN
                                last = INDEX(text, '*')
                                IF (last == 0) THEN
                                    last = 24
                                ELSE
                                    last = INDEX(text(last+2:), ' ') + last
                                END IF
                                i1 = last + 2
                            ELSE
                                i1 = last + 4
                            END IF
                            vtype = text(:last)
                            CALL extract_declarations(i1)
                        ELSE IF (text(:9) == 'DIMENSION') THEN
                            i1 = 11
                            vtype = ' '
                            CALL extract_declarations(i1)
                        END IF
                        IF (ASSOCIATED(current, last_decl)) EXIT
                        current => current % next
                    END DO
                    !     If there are any arguments for which the type has not been determined,
                    !     use the implicit types
                    arg => arg_start
                    DO
                        IF (arg % var_type == ' ')   &
                            arg % var_type = implicit_type(arg % name(1:1))
                        IF (ASSOCIATED(arg, last_arg)) EXIT
                        arg => arg % next
                    END DO
                    RETURN
                END SUBROUTINE get_var_types
                SUBROUTINE get_intents()
                    ! Search thru the body of the current program unit to try to determine
                    ! the intents of dummy arguments.
                    CHARACTER (LEN=80) :: last_part
                    INTEGER            :: j, nbrac
                    DO
                        IF (current % text(1:1) /= '!' .AND. current % text(1:1) /= ' ') THEN
                        statement = current % text
                        IF (statement(1:3) == 'IF ' .OR. statement(1:3) == 'IF(') THEN
                            ! Split line into two parts
                            ! IF (condition) | last_part
                            i = INDEX(statement, '(')
                            length = LEN_TRIM(statement)
                            nbrac = 1
                            DO j = i+1, length-1
                                IF (statement(j:j) == ')') THEN
                                    nbrac = nbrac - 1
                                    IF (nbrac == 0) EXIT
                                ELSE IF (statement(j:j) == '(') THEN
                                    nbrac = nbrac + 1
                                END IF
                            END DO
                            IF (j < length) THEN
                                last_part = statement(j+1:)
                            ELSE
                                last_part = ' '
                            END IF
                            statement = statement(:j)
                            ! It is assumed that a variable inside
                            ! an IF-expression cannot be altered
                            arg => arg_start
                            DO
                                i = find_delimited_name(statement, arg % name)
                                IF (i > 0) THEN
                                    IF (arg % intention == 0) arg % intention = 1
                                END IF
                                IF (ASSOCIATED(arg, last_arg)) EXIT
                                arg => arg % next
                            END DO
                            statement = last_part
                        END IF
                        pos = INDEX(statement, '=', BACK=.TRUE.)
                        !IF (pos > 0) THEN
                        IF (pos > 1) THEN
                            IF (statement(pos-1:pos-1) /= '=' .AND.  &
                                statement(pos-1:pos-1) /= '/' .AND.  &
                                statement(pos-1:pos-1) /= '<' .AND.  &
                                statement(pos-1:pos-1) /= '>') THEN
                                ! Look for each argument name;
                                ! is it before or after '='?
                                arg => arg_start
                                DO
                                    i = find_delimited_name(statement, arg % name)
                                    IF (i > 0) THEN
                                        IF (i < pos) THEN
                                            arg % intention = IOR(arg % intention, 2)
                                        ELSE
                                            IF (arg % intention == 0) arg % intention = 1
                                        END IF
                                    END IF
                                    IF (ASSOCIATED(arg, last_arg)) EXIT
                                    arg => arg % next
                                END DO
                            END IF
                        END IF
                    END IF
                    IF (ASSOCIATED(current, end_prog_unit)) EXIT
                    current => current % next
                END DO
                RETURN
            END SUBROUTINE get_intents
            SUBROUTINE goto_cases(text)
                ! Inserts pairs:
                !   CASE (i)
                !     GO TO i-th label
                ! Terminated with:
                ! END SELECT
                CHARACTER (LEN=*), INTENT(IN OUT) :: text
                INTEGER :: case_number, pos, i2
                case_number = 1
                DO
                    pos = INDEX(text, ',')
                    IF (pos > 0) THEN
                        i2 = pos - 1
                    ELSE
                        i2 = LEN_TRIM(text)
                    END IF
                    CALL insert_and_moveto_newline(current)
                    WRITE(current % text, '("  CASE (", i5, ")")') case_number
                    CALL insert_and_moveto_newline(current)
                    current % text = '    GO TO ' // TRIM(text(:i2))
                    IF (pos == 0) EXIT
                    text = text(pos+1:)
                    case_number = case_number + 1
                END DO
                CALL insert_and_moveto_newline(current)
                current % text = 'END SELECT'
                RETURN
            END SUBROUTINE goto_cases
            SUBROUTINE extract_declarations(start_pos)
                ! Take the current line, and any continuations, look for dummy variables,
                ! and remove them, after storing any relevant type & dimension info.
                INTEGER, INTENT(IN) :: start_pos
                ! Local variables
                INTEGER            :: i, i1, j, ndim
                CHARACTER (LEN=70) :: text
                i1 = start_pos
                DO
                    i = SCAN(current % text(i1:), '(,')            ! Find next ( or ,
                    ndim = 0
                    IF (i == 0) THEN                               ! No comma or ( on this line
                        IF (last_char(current % text) == '&') THEN
                            current => current % next
                            i1 = 1
                            CYCLE
                        ELSE
                            text = ADJUSTL(current % text(i1:))
                            ! Just in case there is an in-line
                            pos = INDEX(text, '!')           ! comment (though illegal in F77)
                            IF (pos > 0) text = text(:pos-1)
                            IF (LEN_TRIM(text) == 0) RETURN
                            pos = LEN_TRIM(current % text)
                        END IF
                    ELSE
                        pos = i + i1 - 1
                        IF (current % text(pos:pos) == ',') THEN     ! Comma found
                            text = current % text(i1:pos-1)
                        ELSE                                         ! ( found; find matching )
                            count = 1
                            ndim = 1
                            pos = pos + 1
                            DO
                                j = SCAN(current % text(pos:), '(,)')
                                IF (j == 0) THEN                         ! No bracket or comma
                                    IF (last_char(current % text) == '&') THEN
                                        length = LEN_TRIM(current % text)
                                        next_line => current % next
                                        current % text = TRIM(current % text(:length-1)) // ' ' //  &
                                            ADJUSTL(next_line % text)
                                        IF (ASSOCIATED(next_line, last_decl)) last_decl => current
                                        current % next => next_line % next
                                        CYCLE
                                    ELSE
                                        RETURN
                                    END IF
                                END IF
                                pos = pos + j - 1
                                SELECT CASE( current % text(pos:pos) )
                                CASE ('(')
                                    count = count + 1
                                CASE (')')
                                    count = count - 1
                                    IF (count <= 0) THEN
                                        text = current % text(i1:pos)
                                        EXIT
                                    END IF
                                CASE (',')
                                    ndim = ndim + 1
                                END SELECT
                                pos = pos + 1
                            END DO                                     ! End matching ) search
                        END IF
                    END IF
                    ! Variable name isolated, with ndim dimensions
                    ! Now see if it matches a dummy argument
                    arg => arg_start
                    text = ADJUSTL(text)
                    IF (ndim <= 0) THEN
                        length = LEN_TRIM(text)
                    ELSE
                        length = INDEX(text, '(') - 1
                    END IF
                    DO
                        IF (text(:length) == arg % name) THEN        ! Argument matched
                            ! Insert variable type
                            IF (arg % var_type == ' ') arg % var_type = vtype
                            IF (ndim > arg % dim) THEN
                                arg % dim = ndim
                                i = INDEX(text, '(')
                                arg % dimensions = text(i:)
                            END IF
                            ! Remove variable ( & comma)
                            text = ADJUSTL( current % text(pos+1:) )
                            IF (LEN_TRIM(text) == 0) THEN
                                IF (i1 > 1) THEN
                                    current % text(i1-1:) = ' '
                                ELSE
                                    current % text = ' '
                                END IF
                                IF (i1 == start_pos) current % text = ' '
                                RETURN
                            ELSE
                                IF (text(1:1) == ',') text = ADJUSTL(text(2:))
                                IF (text(1:1) == '&') THEN
                                    next_line => current % next
                                    IF (i1 == start_pos) THEN
                                        current % text = current % text(:i1-1) // ' ' // &
                                            ADJUSTL(next_line % text)
                                        IF (ASSOCIATED(next_line, last_decl)) last_decl => current
                                        current % next => next_line % next
                                    ELSE
                                        current % text = current % text(:i1-1) // '  &'
                                        current => next_line
                                        i1 = 1
                                    END IF
                                ELSE
                                    current % text = current % text(:i1-1) // ' ' // text
                                END IF
                            END IF
                            EXIT
                        END IF
                        IF (ASSOCIATED(arg, last_arg)) THEN
                            i1 = pos + 1                               ! Skip over comma, if present
                            EXIT
                        END IF
                        arg => arg % next
                    END DO
                END DO
                RETURN
            END SUBROUTINE extract_declarations
            SUBROUTINE convert_parameter(start)
                ! Convert PARAMETER statements from:
                ! PARAMETER (name1 = value1, name2 = value2, ... )
                ! to:
                ! TYPE1, PARAMETER :: name1 = value1
                ! TYPE2, PARAMETER :: name2 = value2
                TYPE (code), POINTER           :: start
                ! Local variables
                TYPE (code), POINTER :: current, next_line
                INTEGER              :: count, i, j, length, pos
                CHARACTER (LEN=10)   :: text
                CHARACTER (LEN=30)   :: vtype
                current => start
                ! Replace opening ( with ::
                i = INDEX(current % text, '(')
                IF (i == 0) RETURN
                current % text = TRIM(current % text(:i-1)) // ' :: ' //  &
                    ADJUSTL(current % text(i+1:))
                i = INDEX(current % text, '::') + 3
                DO
                    j = INDEX(current % text(i:), '=')
                    IF (j == 0) THEN
                        IF (last_char(current % text) /= '&') RETURN
                        next_line => current % next
                        j = LEN_TRIM(current % text)
                        current % text = TRIM(current % text(:j-1)) // next_line % text
                        current % next => next_line % next
                        j = INDEX(current % text(i:), '=')
                        IF (j == 0) RETURN
                    END IF
                    j = i + j - 1
                    text = ADJUSTL(current % text(i:j-1))
                    CALL find_type(text, vtype, first_decl, start)
                    current % text = TRIM(vtype) // ', ' // current % text
                    j = j + 2 + LEN_TRIM(vtype)
                    ! Is there another value set in this statement?
                    ! Find end of the expression for the value, which may involve brackets
                    ! and commas.
                    10 length = LEN_TRIM(current % text)
                    count = 0
                    DO i = j+1,length
                        SELECT CASE (current % text(i:i))
                        CASE ('(')
                            count = count + 1
                        CASE (')')
                            count = count - 1
                            IF (count < 0) THEN
                                ! Remove final ) and return
                                current % text = current % text(:i-1)
                                RETURN
                            END IF
                        CASE (',')
                            ! If count = 0, there is another declaration
                            IF (count == 0) THEN
                                ! Break line, check for '&' as first character
                                text = ADJUSTL(current % text(i+1:))
                                IF (text(1:1) == '&') THEN
                                    current % text = current % text(:i-1)
                                    current => current % next
                                    current % text = 'PARAMETER :: ' // ADJUSTL(current % text)
                                ELSE
                                    ALLOCATE(next_line)
                                    next_line % next => current % next
                                    current % next => next_line
                                    next_line % text = 'PARAMETER :: ' // ADJUSTL(current % text(i+1:))
                                    current % text = current % text(:i-1)
                                    IF(ASSOCIATED(current, last_decl)) last_decl => next_line
                                    current => next_line
                                    start => start % next
                                END IF
                                EXIT
                            END IF
                        CASE ('&')
                            ! Expression continued on next line, merge lines
                            next_line => current % next
                            pos = LEN_TRIM(current % text(:i-1))
                            current % text = current % text(:pos) // next_line % text
                            current % next => next_line % next
                            GO TO 10
                        END SELECT
                    END DO
                    IF (i > length) EXIT
                    i = 14
                END DO
                RETURN
            END SUBROUTINE convert_parameter
            SUBROUTINE find_type(vname, vtype, first_decl, last_decl)
                !     Find the type of variable 'vname'
                CHARACTER (LEN=*), INTENT(IN)  :: vname
                CHARACTER (LEN=*), INTENT(OUT) :: vtype
                TYPE (code), POINTER           :: first_decl, last_decl
                ! Local variables
                TYPE (code), POINTER :: current
                CHARACTER (LEN=30)   :: text
                INTEGER              :: i1, last, length, pos
                current => first_decl
                length = LEN_TRIM(vname)
                IF (length == 0) RETURN
                DO
                    text = current % text(:30)
                    !IF (text(:4) == 'REAL' .OR. text(:7) == 'INTEGER' .OR.     &
                    !    text(:6) == 'DOUBLE' .OR. text(:9) == 'CHARACTER' .OR. &
                    !    text(:7) == 'LOGICAL' .OR. text(:7) == 'COMPLEX') THEN
                    IF (text(:4) == 'REAL' .OR. text(:7) == 'INTEGER' .OR.     &
                        text(:8) == 'DOUBLE P' .OR. text(:9) == 'CHARACTER' .OR. &
                        text(:7) == 'LOGICAL' .OR. text(:7) == 'COMPLEX' .OR. &
                        text(:8) == 'DOUBLE C') THEN
                        ! Copy the variable type to vtype
                        last = INDEX(text, ' ::') - 1
                        IF (last < 0) THEN
                            last = INDEX(text, '*')
                            IF (last == 0) THEN
                                last = 24
                            ELSE
                                last = INDEX(text(last+2:), ' ') + last
                            END IF
                            i1 = last + 2
                        ELSE
                            i1 = last + 4
                        END IF
                        vtype = text(:last)
                        ! See if variable is declared on this line (& any continuation)
                        DO
                            pos = find_delimited_name(current % text(i1:), vname(:length))
                            IF (pos == 0) THEN
                                IF (last_char(current % text) == '&') THEN
                                    current => current % next
                                    i1 = 1
                                    CYCLE
                                END IF
                            END IF
                            EXIT
                        END DO
                        ! Variable name found if pos > 0.
                        IF (pos > 0) THEN                  ! Remove variable name
                            pos = pos + i1 - 1
                            current % text = current % text(:pos-1) // current % text(pos+length:)
                            ! Delete line if only TYPE :: remains
                            IF (last_char(current % text) == ':') THEN
                                current % text = ' '
                                RETURN
                            END IF
                            ! Remove any following comma
                            i = pos
                            length = LEN_TRIM(current % text)
                            DO
                                IF (i > length) THEN
                                    RETURN
                                ELSE IF (current % text(i:i) == ',') THEN
                                    current % text = current % text(:i-1) // current % text(i+1:)
                                    RETURN
                                ELSE IF (current % text(i:i) /= ' ') THEN
                                    RETURN
                                END IF
                                i = i + 1
                            END DO
                        END IF
                    END IF
                    ! If last declaration has been reached, return default type.
                    ! Otherwise proceed to next line.
                    IF (ASSOCIATED(current, last_decl)) THEN
                        vtype = implicit_type(vname(1:1))
                        EXIT
                    ELSE
                        current => current % next
                    END IF
                END DO
                RETURN
            END SUBROUTINE find_type
        END PROGRAM to_f90
        SUBROUTINE mark_text(text, n_marks, pos1, pos2, continuation)
            !     Look for exclamation marks or quotes to find any text which must be
            !     protected from case changes.
            !     It is assumed that strings are NOT continued from one line to the next.
            IMPLICIT NONE
            CHARACTER (LEN = *), INTENT(IN)  :: text
            LOGICAL, INTENT(IN)              :: continuation
            INTEGER, INTENT(OUT)             :: n_marks, pos1(:), pos2(:)
            !     Local variables
            INTEGER                  :: mark, start, pos_exclaim, pos_sngl_quote,  &
                pos_dbl_quote, pos, endpos
            CHARACTER (LEN=1), SAVE  :: quote
            LOGICAL, SAVE            :: protect = .FALSE.
            mark = 1
            start = 1
            IF (continuation .AND. protect) THEN
                pos1(mark) = 1
                pos = 0
                GO TO 20
            END IF
            ! Find next opening quote or exclamation mark
            10 protect = .FALSE.
            pos_exclaim = INDEX(text(start:80), '!')
            pos_sngl_quote = INDEX(text(start:80), "'")
            pos_dbl_quote = INDEX(text(start:80), '"')
            IF (pos_exclaim == 0) pos_exclaim = 81
            IF (pos_sngl_quote == 0) pos_sngl_quote = 81
            IF (pos_dbl_quote == 0) pos_dbl_quote = 81
            pos1(mark) = MIN(pos_exclaim, pos_sngl_quote, pos_dbl_quote)
            IF (pos1(mark) == 81) THEN                 ! No more protected regions
                n_marks = mark - 1
                RETURN
            ELSE IF (pos_exclaim == pos1(mark)) THEN   ! Rest of line is a comment
                pos1(mark) = pos1(mark) + start - 1
                pos2(mark) = 80
                n_marks = mark
                RETURN
            END IF
            pos = start - 1 + pos1(mark)
            pos1(mark) = pos
            quote = text(pos:pos)
            ! Search for matching quote
            20 endpos = INDEX(text(pos+1:), quote)
            IF (endpos > 0) THEN
                pos2(mark) = pos + endpos
                start = pos2(mark) + 1
                mark = mark + 1
                GO TO 10
            END IF
            ! No matching end quote - it should be on the next line
            pos2(mark) = 80
            n_marks = mark
            protect = .TRUE.
            RETURN
        END SUBROUTINE mark_text
        SUBROUTINE convert_text(text, n_marks, pos1, pos2)
            !     Convert unprotected text to upper case if it is a FORTRAN word,
            !     otherwise convert to lower case.
            IMPLICIT NONE
            CHARACTER (LEN = *), INTENT(IN OUT) :: text
            INTEGER, INTENT(IN)                 :: n_marks
            INTEGER, INTENT(IN OUT)             :: pos1(:), pos2(:)
            !     Local variables
            INTEGER               :: length, inc = ICHAR('A') - ICHAR('a'),      &
                pos, mark, i, i1, j, j1, j2, ptr
            LOGICAL               :: matched
            CHARACTER (LEN = 11)  :: fortran_word(186) = (/ "ABS        ","ACCESS     ",  &
                "ACOS       ","AIMAG      ","AINT       ","ALOG       ","ALOG10     ",  &
                "AMAX0      ","AMAX1      ","AMIN0      ","AMIN1      ","AMOD       ",  &
                "AND        ","ANINT      ","APPEND     ","ASIN       ","ASSIGN     ",  &
                "ATAN       ","ATAN2      ","BACKSPACE  ","BLANK      ","BLOCK      ",  &
                "BLOCKDATA  ","BLOCKSIZE  ","CALL       ","CCOS       ","CDABS      ",  &
                "CDCOS      ","CDEXP      ","CDLOG      ","CDSIN      ","CDSQRT     ",  &
                "CEXP       ","CHAR       ","CHARACTER  ","CLOG       ","CLOSE      ",  &
                "CMPLX      ","COMMON     ","COMPLEX    ","CONJG      ","CONTINUE   ",  &
                "COS        ","COSH       ","CSIN       ","CSQRT      ","DABS       ",  &
                "DACOS      ","DASIN      ","DATA       ","DATAN      ","DATAN2     ",  &
                "DBLE       ","DCMPLX     ","DCONJG     ","DCOS       ","DCOSH      ",  &
                "DELETE     ","DEXP       ","DIMAG      ","DINT       ","DIRECT     ",  &
                "DLOG       ","DLOG10     ","DMAX1      ","DIMENSION  ","DMIN1      ",  &
                "DMOD       ","DNINT      ","DO         ","DOUBLE     ","DSIGN      ",  &
                "DSIN       ","DSINH      ","DSQRT      ","DTAN       ","DTANH      ",  &
                "ELSE       ","ELSEIF     ","END        ","ENDFILE    ","ENDIF      ",  &
                "ENTRY      ","EQ         ","EQUIVALENCE","EQV        ","ERR        ",  &
                "EXIST      ","EXIT       ","EXP        ","EXTERNAL   ","FILE       ",  &
                "FLOAT      ","FMT        ","FORM       ","FORMAT     ","FORMATTED  ",  &
                "FUNCTION   ","GE         ","GOTO       ","GO         ","GT         ",  &
                "IABS       ","IAND       ","ICHAR      ","IDINT      ","IDNINT     ",  &
                "IEOR       ","IF         ","IFIX       ","IMPLICIT   ","INCLUDE    ",  &
                "INDEX      ","INPUT      ","INQUIRE    ","INT        ","INTEGER    ",  &
                "INTRINSIC  ","IOSTAT     ","ISIGN      ","KEEP       ","LE         ",  &
                "LEN        ","LGE        ","LGT        ","LLE        ","LLT        ",  &
                "LOG        ","LOG10      ","LOGICAL    ","LT         ","MAX        ",  &
                "MAX0       ","MAX1       ","MIN        ","MIN0       ","MIN1       ",  &
                "MOD        ","NAME       ","NAMELIST   ","NAMED      ","NE         ",  &
                "NEQV       ","NEW        ","NEXTREC    ","NONE       ","NOT        ",  &
                "NUMBER     ","OLD        ","OPEN       ","OPENED     ","OR         ",  &
                "PARAMETER  ","PAUSE      ","POSITION   ","PRECISION  ","PRINT      ",  &
                "PROGRAM    ","READ       ","REAL       ","REC        ","RECL       ",  &
                "RETURN     ","REWIND     ","SAVE       ","SCRATCH    ","SEQUENTIAL ",  &
                "SIGN       ","SIN        ","SINH       ","SNGL       ","SPACE      ",  &
                "SQRT       ","STATUS     ","STOP       ","SUBROUTINE ","TAN        ",  &
                "TANH       ","THEN       ","TO         ","TYPE       ","UNFORMATTED",  &
                "UNIT       ","UNKNOWN    ","WHILE      ","WRITE      " /)
            CHARACTER (LEN = 4)   :: compare(6) = (/ ".LT.", ".LE.", ".EQ.", ".GE.",      &
                ".GT.", ".NE." /)
            CHARACTER (LEN = 2)   :: replacement(6) = (/ "< ", "<=", "==", ">=", "> ",    &
                "/=" /)
            !          A   B   C   D   E   F   G    H    I    J    K    L    M    N    O
            !          P    Q    R    S    T    U    V    W    X    Y    Z
            INTEGER, PARAMETER :: indx(27) = (/  &
                1, 20, 25, 47, 78, 92, 99, 103, 103, 121, 121, 122, 132, 139, 149, &
                153, 159, 159, 165, 177, 182, 185, 185, 187, 187, 187, 187 /)
            IF (pos1(1) == 1 .AND. pos2(1) == 80) RETURN      ! Entire line protected
            pos = 1
            mark = 1
            length = LEN_TRIM(text)
            DO                                     ! Convert to upper case
                IF (n_marks >= mark .AND. pos == pos1(mark)) THEN
                    pos = pos2(mark) + 1
                    mark = mark + 1
                    IF (pos >= length) EXIT
                END IF
                IF (text(pos:pos) >= 'a' .AND. text(pos:pos) <= 'z')           &
                    text(pos:pos) = CHAR ( ICHAR(text(pos:pos)) + inc )
                pos = pos + 1
                IF (pos > length) EXIT
            END DO
            !     Search for `words' in text.
            !     Convert to lower case if they are not FORTRAN words.
            i1 = 1
            pos = 1
            mark = 1
            DO
                IF (pos > length) EXIT
                IF (n_marks >= mark .AND. pos >= pos1(mark)) THEN
                    pos = pos2(mark) + 1
                    i1 = pos
                    mark = mark + 1
                    IF (pos >= length) EXIT
                END IF
                DO
                    IF ((text(pos:pos) >= 'A' .AND. text(pos:pos) <= 'Z')        &
                        .OR. (text(pos:pos) >= '0' .AND. text(pos:pos) <= '9')   &
                        .OR. text(pos:pos) == '_') THEN
                        pos = pos + 1
                        CYCLE
                    ELSE
                        EXIT
                    END IF
                END DO
                pos = pos - 1
                ! Now i1 & pos = positions of 1st & last characters of current string
                IF (pos < i1) THEN                ! Single non-alphanumeric character
                    pos = i1 + 1
                    i1 = pos
                    CYCLE
                END IF
                ptr = ICHAR(text(i1:i1)) - ICHAR('A') + 1
                IF (ptr < 1 .OR. ptr > 26) THEN
                    pos = pos + 1
                    IF (pos > length) EXIT
                    i1 = pos
                    CYCLE
                END IF
                matched = .FALSE.
                IF (pos > i1) THEN
                    j1 = indx(ptr)
                    j2 = indx(ptr+1) - 1
                    DO j = j1, j2
                        IF (text(i1:pos) == fortran_word(j)) THEN
                            matched = .TRUE.
                            EXIT
                        END IF
                    END DO
                END IF
                ! Replace .LT. with <, etc.
                IF (matched .AND. i1 > 1) THEN
                    IF(text(i1-1:i1-1) == '.') THEN
                        DO j = 1, 6
                            IF (text(i1-1:pos+1) == compare(j)) THEN
                                text(i1-1:pos+1) = ' ' // replacement(j) // ' '
                                EXIT
                            END IF
                        END DO
                        DO                                 ! Remove excess blanks
                            i1 = MAX(i1, 3)
                            j1 = INDEX(text(i1-2:pos+2), '  ')
                            IF (j1 == 0) EXIT
                            j1 = j1 + i1 - 3
                            text(j1:) = text(j1+1:)
                            pos2(mark) = pos2(mark) - 1      ! Adjust mark positions
                            DO i = mark+1, n_marks
                                pos1(i) = pos1(i) - 1
                                pos2(i) = pos2(i) - 1
                            END DO
                            pos = pos - 1
                        END DO
                    END IF
                END IF
                ! Output line of text to screen if it contains SUBROUTINE or FUNCTION.
                ! Convert ENDIF to END IF, ELSEIF to ELSE IF, and GOTO to GO TO.
                IF (matched) THEN
                    IF (text(i1:pos) == 'SUBROUTINE' .OR. text(i1:pos) == 'FUNCTION') THEN
                        WRITE(*, '(1x, a)') text(1:length)
                    ELSE IF (text(i1:pos) == 'ENDIF') THEN
                        text(i1:) = 'END IF' // text(pos+1:)
                        pos = pos + 1
                    ELSE IF (text(i1:pos) == 'ELSEIF') THEN
                        text(i1:) = 'ELSE IF' // text(pos+1:)
                        pos = pos + 1
                    ELSE IF (text(i1:pos) == 'GOTO') THEN
                        text(i1:) = 'GO TO' // text(pos+1:)
                        pos = pos + 1
                    END IF
                END IF
                ! If text is not matched, convert to lower case, if necessary.
                IF (.NOT. matched) THEN
                    DO j = i1, pos
                        IF (text(j:j) >= 'A' .AND. text(j:j) <= 'Z')              &
                            text(j:j) = CHAR ( ICHAR(text(j:j)) - inc )
                    END DO
                END IF
                pos = pos + 1
                IF (pos > length) EXIT
                i1 = pos
            END DO
            RETURN
        END SUBROUTINE convert_text
        SUBROUTINE remove_data_blanks(text)
            ! Remove any blanks embedded between numerical digits in DATA statements
            IMPLICIT NONE
            CHARACTER (LEN=*), INTENT(IN OUT) :: text
            ! Local variables
            INTEGER            :: length, pos, i1
            CHARACTER (LEN=10) :: numbers = '1234567890'
            length = LEN_TRIM(text)
            i1 = 2
            DO
                pos = INDEX(text(i1:length), ' ')
                IF (pos == 0) EXIT
                i1 = i1 + pos - 1
                IF (SCAN(text(i1-1:i1-1), numbers) > 0 .AND.  &
                    SCAN(text(i1+1:i1+1), numbers) > 0) THEN
                    text = text(:i1-1) // text(i1+1:length)
                    length = length - 1
                END IF
                i1 = i1 + 2
                IF (i1 > length) EXIT
            END DO
            RETURN
        END SUBROUTINE remove_data_blanks
        FUNCTION last_char( text ) RESULT(ch)
            ! Return the last character on a line
            IMPLICIT NONE
            CHARACTER (LEN=*), INTENT(IN) :: text
            CHARACTER (LEN=1)             :: ch
            ! Local variable
            INTEGER :: last
            last = LEN_TRIM( text )
            IF (last == 0) THEN
                ch = ' '
            ELSE
                ch = text(last:last)
            END IF
            RETURN
        END FUNCTION last_char
        FUNCTION find_delimited_name (text, name) RESULT(pos)
            ! Find a name in a character string with delimiters either side of it,
            ! or after it if it starts at position 1.
            ! An extended version of the intrinsic INDEX.
            ! pos = the position of the first character of name in text (= 0 if not found).
            ! N.B. When the name is short (e.g. i or n) it could occur as part of some
            !      other name.
            IMPLICIT NONE
            CHARACTER (LEN=*), INTENT(IN) :: text, name
            INTEGER                       :: pos
            ! Local variables
            INTEGER :: i1, ltext, lname
            i1 = 1
            ltext = LEN_TRIM(text)
            lname = LEN_TRIM(name)
            DO
                pos = INDEX(text(i1:ltext), TRIM(name))
                IF (pos == 0) RETURN
                pos = pos + i1 - 1
                IF (pos > 1) THEN
                    IF ( SCAN(text(pos-1:pos-1), ' <=+-/*,') > 0 ) THEN
                        IF ( SCAN(text(pos+lname:pos+lname), ' >=(+-/*,') > 0 ) RETURN
                    END IF
                ELSE
                    IF ( SCAN(text(pos+lname:pos+lname), ' >=(+-/*,') > 0 ) RETURN
                END IF
                i1 = pos + lname
                IF (i1 + lname > ltext) EXIT
            END DO
            pos = 0
            RETURN
        END FUNCTION find_delimited_name
